home *** CD-ROM | disk | FTP | other *** search
/ Mac Expert 1995 Winter / Mac Expert - Winter 95.iso / Les fichiers / Utilitaires divers / Images / Image 1.37 ƒ / Macros / 3D Reconstruction next >
Encoding:
Text File  |  1991-03-25  |  7.6 KB  |  309 lines  |  [TEXT/MSWD]
  1. var  {Global variables that are set to zero when macros are loaded.}
  2.   SliceThickness,scale:real;
  3.   nImages:integer;
  4.   ScaleSet:boolean;
  5.  
  6.  
  7. procedure CheckImages;
  8. begin
  9.   if (nPics<2) or not AllSameSize then begin
  10.     PutMessage('Reconstruction requires a set of equal size images.');
  11.     Exit;
  12.   end;
  13. end;
  14.  
  15.  
  16. procedure GetSliceThickness;
  17. begin
  18.   if scale=0 then scale:=1.5;
  19.   if SliceThickness=0 then SliceThickness:=5;
  20.   SliceThickness:=GetNumber('SliceThickness(pixels):',SliceThickness);
  21. end;
  22.  
  23.  
  24. procedure GetCount;
  25. begin
  26.   if nImages=0 then nImages:=nPics;
  27.   nImages:=GetNumber('Number of images to reconstruct:',nImages);
  28. end;
  29.  
  30.  
  31. macro 'Reconstruct One Slice [R]'
  32. var
  33.   width,height,i,nSlices,dst,DstLeft,DstTop,x,y:integer;
  34.   x1,y1,x2,y2,LineWidth,DstWidth,DstHeight:integer;
  35.   RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  36.   HorizontalSlice:boolean;
  37. begin
  38.   CheckImages;
  39.   if SliceThickness=0 then GetSliceThickness;
  40.   nSlices:=nPics;
  41.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  42.   if RoiWidth=0 then begin
  43.     PutMessage('Please make a horizontally or vertically oriented rectangular selection.');
  44.     exit;
  45.   end;
  46.   HorizontalSlice:=RoiWidth>=RoiHeight;
  47.   if HorizontalSlice then begin
  48.     dstWidth:=RoiWidth*scale;
  49.     dstHeight:=nSlices*SliceThickness*scale
  50.   end else begin
  51.     dstWidth:=RoiHeight*scale;
  52.     dstHeight:=nSlices*SliceThickness*scale;
  53.   end;
  54.   SetNewSize(dstWidth,dstHeight);
  55.   MakeNewWindow('Reconstruction');
  56.   dst:=nPics;
  57.   SetScaling('Bilinear; Same Window');
  58.   if HorizontalSlice then begin
  59.     y:=RoiTop+RoiHeight/2;
  60.     dstLeft:=(dstWidth-RoiWidth)/2;
  61.     dstTop:=(dstHeight-nSlices)/2
  62.     for i:=1 to nSlices do begin
  63.       ChoosePic(i);
  64.       GetRow(RoiLeft,y,RoiWidth);
  65.       SelectPic(dst);
  66.       PutRow(dstLeft,dstTop+nSlices-i,RoiWidth);
  67.     end;
  68.     PutRow(dstLeft,dstTop+nSlices,RoiWidth);
  69.     MakeRoi(dstLeft,dstTop,RoiWidth,nSlices);
  70.   end else begin
  71.     x:=RoiLeft+RoiWidth/2;
  72.     dstLeft:=(dstWidth-RoiHeight)/2;
  73.     dstTop:=(dstHeight-nSlices)/2
  74.     for i:=1 to nSlices do begin
  75.       ChoosePic(i);
  76.       GetColumn(x,RoiTop,RoiHeight);
  77.       SelectPic(dst);
  78.       PutRow(dstLeft,dstTop+nSlices-i,RoiHeight);
  79.      end;
  80.      PutRow(dstLeft,dstTop+nSlices,RoiHeight);
  81.      MakeRoi(DstLeft,dstTop,RoiHeight,nSlices);
  82.   end;
  83.   ScaleAndRotate(scale,SliceThickness*scale,0);
  84.   KillRoi;
  85. end;
  86.  
  87.  
  88. macro 'Reconstruct Horizontal Set [H]'
  89. var
  90.   i,j,nSlices,dst,dstLeft,dstTop,x,y:integer;
  91.   x1,y1,x2,y2,LineWidth,DstWidth,DstHeight:integer;
  92.   RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  93.   dstImageNum,step:integer;
  94. begin
  95.   CheckImages;
  96.   if SliceThickness=0 then GetSliceThickness;
  97.   GetCount;
  98.   if not ScaleSet then scale:=1;
  99.   nSlices:=nPics;
  100.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  101.   if RoiWidth=0 then begin
  102.     PutMessage('Please make a rectangular selection.');
  103.     exit;
  104.   end;
  105.   dstWidth := RoiWidth*scale;
  106.   dstHeight := nSlices*SliceThickness*scale;
  107.   dst := nPics;
  108.   step:=RoiHeight div nImages;
  109.   SetScaling('Bilinear; Same Window');
  110.   for j:=1 to nImages do begin
  111.     dst:=dst+1
  112.     SetNewSize(dstWidth,dstHeight);
  113.     MakeNewWindow(j:3,'-',step:2);
  114.     dstLeft:=(dstWidth-RoiWidth)/2;
  115.     dstTop:=(dstHeight-nSlices)/2
  116.     y:=RoiTop+(j*step)*RoiHeight/RoiHeight
  117.     for i:=1 to nSlices do begin
  118.       ChoosePic(i);
  119.       GetRow(RoiLeft,y,RoiWidth);
  120.       SelectPic(dst);
  121.       PutRow(dstLeft,dstTop+nSlices-i,RoiWidth);
  122.     end;
  123.     PutRow(dstLeft,dstTop+nSlices,RoiWidth);
  124.     MakeRoi(dstLeft,dstTop,RoiWidth,nSlices);
  125.     ScaleAndRotate(scale,SliceThickness*scale,0);
  126.     KillRoi;
  127.   end;
  128.   for i:=1 to nSlices do begin
  129.     ChoosePic(1);
  130.     Dispose;
  131.   end;
  132.   SliceThickness:=0;
  133. end;
  134.  
  135.  
  136. macro 'Horizontal Set to Disk'
  137. var
  138.   i,j,nSlices,dstLeft,dstTop,x,y,step:integer;
  139.   x1,y1,x2,y2,LineWidth,DstWidth,DstHeight:integer;
  140.   RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  141. begin
  142.   CheckImages;
  143.   if SliceThickness=0 then GetSliceThickness;
  144.   GetCount;
  145.   if not ScaleSet then scale:=1;
  146.   nSlices:=nPics;
  147.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  148.   if RoiWidth=0 then begin
  149.     PutMessage('Please make a rectangular selection.');
  150.     exit;
  151.   end;
  152.   dstWidth := RoiWidth*scale;
  153.   dstHeight := nSlices*SliceThickness*scale;
  154.   step:=RoiHeight div nImages;
  155.   SetScaling('Bilinear; Same Window');
  156.   for j:=1 to nImages do begin
  157.     SetNewSize(dstWidth,dstHeight);
  158.     MakeNewWindow(j:3,'-',step:2);
  159.     dstLeft:=(dstWidth-RoiWidth)/2;
  160.     dstTop:=(dstHeight-nSlices)/2
  161.     y:=RoiTop+(j*step)*RoiHeight/RoiHeight
  162.     for i:=1 to nSlices do begin
  163.       ChoosePic(i);
  164.       GetRow(RoiLeft,y,RoiWidth);
  165.       SelectPic(nPics);
  166.       PutRow(dstLeft,dstTop+nSlices-i,RoiWidth);
  167.     end;
  168.     PutRow(dstLeft,dstTop+nSlices,RoiWidth);
  169.     MakeRoi(dstLeft,dstTop,RoiWidth,nSlices);
  170.     ScaleAndRotate(scale,SliceThickness*scale,0);
  171.     KillRoi;
  172.     SaveAs (j);
  173.     Dispose;
  174.   end;
  175. end;
  176.  
  177.  
  178. macro 'Reconstruct Vertical Set [V]'
  179. var
  180.   i,j,nSlices,dst,dstLeft,dstTop,x,y:integer;
  181.   x1,y1,x2,y2,LineWidth,DstWidth,DstHeight:integer;
  182.   RoiLeft,RoiTop,RoiWidth,RoiHeight,step:integer;
  183. begin
  184.   CheckImages;
  185.   if SliceThickness=0 then GetSliceThickness;
  186.   GetCount;
  187.   if not ScaleSet then scale:=1;
  188.   nSlices:=nPics;
  189.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  190.   if RoiWidth=0 then begin
  191.     PutMessage('Please make a rectangular selection.');
  192.     exit;
  193.   end;
  194.   dstWidth := RoiHeight*scale;
  195.   dstHeight := nSlices*SliceThickness*scale;
  196.   dst := nPics;
  197.   step:=RoiWidth div nImages;
  198.   SetScaling('Bilinear; Same Window');
  199.   for j:=1 to nImages do begin
  200.     dst:=dst+1
  201.     SetNewSize(dstWidth,dstHeight);
  202.     MakeNewWindow(j:3,'-',step:2);
  203.     dstLeft:=(dstWidth-RoiHeight)/2;
  204.     dstTop:=(dstHeight-nSlices)/2
  205.     x:=RoiLeft+(j*step)*RoiWidth/RoiWidth
  206.     for i:=1 to nSlices do begin
  207.       ChoosePic(i);
  208.       GetColumn(x,RoiTop,RoiHeight);
  209.       SelectPic(dst);
  210.       PutRow(dstLeft,dstTop+nSlices-i,RoiHeight);
  211.     end;
  212.     PutRow(dstLeft,dstTop+nSlices,RoiHeight);
  213.     MakeRoi(dstLeft,dstTop,RoiHeight,nSlices);
  214.     ScaleAndRotate(scale,SliceThickness*scale,0);
  215.     KillRoi;
  216.   end;
  217.  for i:=1 to nSlices do begin
  218.     ChoosePic(1);
  219.     Dispose;
  220.   end;
  221.   SliceThickness:=0;
  222. end;
  223.  
  224.  
  225. macro 'Vertical Set to Disk';
  226. var
  227.   i,j,nSlices,dst,dstLeft,dstTop,x,y:integer;
  228.   x1,y1,x2,y2,LineWidth,DstWidth,DstHeight:integer;
  229.   RoiLeft,RoiTop,RoiWidth,RoiHeight,step:integer;
  230. begin
  231.   CheckImages;
  232.   if SliceThickness=0 then GetSliceThickness;
  233.   GetCount;
  234.   if not ScaleSet then scale:=1;
  235.   nSlices:=nPics;
  236.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  237.   if RoiWidth=0 then begin
  238.     PutMessage('Please make a rectangular selection.');
  239.     exit;
  240.   end;
  241.   dstWidth := RoiHeight*scale;
  242.   dstHeight := nSlices*SliceThickness*scale;
  243.   dst := nPics;
  244.   step:=RoiWidth div nImages;
  245.   SetScaling('Bilinear; Same Window');
  246.   for j:=1 to nImages do begin
  247.     dst:=dst+1
  248.     SetNewSize(dstWidth,dstHeight);
  249.     MakeNewWindow(j:3,'-',step:2);
  250.     dstLeft:=(dstWidth-RoiHeight)/2;
  251.     dstTop:=(dstHeight-nSlices)/2
  252.     x:=RoiLeft+(j*step)*RoiWidth/RoiWidth
  253.     for i:=1 to nSlices do begin
  254.       ChoosePic(i);
  255.       GetColumn(x,RoiTop,RoiHeight);
  256.       SelectPic(nPics);
  257.       PutRow(dstLeft,dstTop+nSlices-i,RoiHeight);
  258.     end;
  259.     PutRow(dstLeft,dstTop+nSlices,RoiHeight);
  260.     MakeRoi(dstLeft,dstTop,RoiHeight,nSlices);
  261.     ScaleAndRotate(scale,SliceThickness*scale,0);
  262.     KillRoi;
  263.     SaveAs (j);
  264.     Dispose;
  265.   end;
  266. end;
  267.  
  268.  
  269. macro 'Renumber Windows';
  270. var
  271.   i:integer;
  272. begin
  273.   for i:= 1 to nPics do begin
  274.     SelectPic(i);
  275.     SetPicName(i); 
  276.   end;
  277. end;
  278.  
  279.  
  280. macro 'Dispose All Windows'
  281. begin
  282.   DisposeAll;
  283. end;
  284.  
  285.  
  286. macro '(---'; begin end;
  287.  
  288.  
  289. macro 'Set Slice Thickness [T]';
  290. begin
  291.   GetSliceThickness;
  292. end;
  293.  
  294.  
  295. Macro 'Set Scale [S]';
  296. begin
  297.   if scale=0 then scale:=1.5;
  298.   scale:=GetNumber('ScaleFactor:',scale);
  299.   ScaleSet:=true;
  300. end;
  301.  
  302.  
  303. Macro 'Set number of Images';
  304. begin
  305.   GetCount;
  306. end;
  307.  
  308.  
  309.